#!/usr/bin/env wish
# -*-tcl-*-

set u 10;				# Unit length in mm
set w 4;				# Line width for pieces
set delay 100;				# Delay between updates in ms

# xtrans, ytrans -- transform mathematical to screen coordinates
proc xtrans {x} {global u; return [expr {($x + 0.5) * $u}]m}
proc ytrans {y} {global u ymax; return [expr {($ymax - $y + 1.5) * $u}]m}

# Create GUI elements
canvas .canv -background white
label .status -anchor w
frame .butbar
button .pause -text Step -command pause
button .run -text Run -command run
button .quit -text Quit -command exit
pack .canv
pack .status -fill x
pack .pause .run .quit -in .butbar -side left
pack .butbar
bind . q exit

# coords -- split coordinates into x and y
proc coords {p x y} {
    upvar $x xx $y yy
    regexp {\((.*),(.*)\)} $p dummy xx yy
}

# dx(dir) and dy(dir) form a unit vector in direction dir.
set dx(right) 1; set dy(right) 0; set dx(up) 0; set dy(up) 1
set dx(left) -1; set dy(left) 0; set dx(down) 0; set dy(down) -1

# ccw(dir) and cw(dir) are the directions after turning left and right
set ccw(right) up; set ccw(up) left; set ccw(left) down; set ccw(down) right
set cw(right) down; set cw(down) left; set cw(left) up; set cw(up) right

# Standing at (x,y) and looking in direction dir, the square to the left 
# of your path has coordinates (x+inx(dir), y+iny(dir)) for its SW corner.
# Explanation: the far corner of that square is at (x,y) + dir + ccw(dir),
# so the centre is at (x,y) + (dir + ccw(dir))/2, and the SW corner is at
# (x,y) + (dir + ccw(dir))/2 - (1/2,1/2).
foreach dir {right up left down} {
    set inx($dir) [expr {($dx($dir)+$dx($ccw($dir))-1)/2}]
    set iny($dir) [expr {($dy($dir)+$dy($ccw($dir))-1)/2}]
}

# memsquare -- test if a square belongs to a shape
proc memsquare {x y squares} {
    return [expr {[lsearch -exact $squares ($x,$y)] >= 0}]
} 

# follow -- test if a given direction has a full square to the left
proc follow {x y dir squares} {
    global inx iny
    set x1 [expr {$x+$inx($dir)}]; set y1 [expr {$y+$iny($dir)}]
    return [memsquare $x1 $y1 $squares]
}

# outline -- compute the polygonal outline of a piece
proc outline {squares} {
    global dx dy ccw cw

    # Find a horizontal segment of the boundary
    coords [lindex $squares 0] x y
    while {[memsquare $x [expr {$y-1}] $squares]} {incr y -1}

    # Now stand with your left hand on the boundary and follow
    # it counter-clockwise
    set vertices {}
    set x0 $x; set y0 $y; set dir right
    while {1} {
	# Take one pace forward
	incr x $dx($dir); incr y $dy($dir)

        # Examine the two squares in front
	if {[follow $x $y $cw($dir) $squares]} {
	    # There's a wall to the right
	    lappend vertices [xtrans $x] [ytrans $y]
	    set dir $cw($dir)
	} elseif {! [follow $x $y $dir $squares]} {
	    # There's empty space to the left
	    lappend vertices [xtrans $x] [ytrans $y]
	    set dir $ccw($dir)
	}

	if {$x == $x0 && $y == $y0} break
    }

    return $vertices
}
    
### Here are the commands we accept from the client program

# bounds -- set bounds of playing area
proc bounds {xmx ymx} {
    global u ymax

    set ymax $ymx
    .canv configure -height [expr ($ymx + 2) * $u]m \
	-width [expr ($xmx + 2) * $u]m
}

# squares -- create grey squares for the arena
proc squares {args} {
    foreach p $args {
	coords $p x y 
	.canv create rectangle [xtrans $x] [ytrans $y] \
	    [xtrans [expr {$x+1}]] [ytrans [expr {$y+1}]] \
	    -tag square -fill lightgrey
    }
    update idletasks
}

# 13 colours just in case!
set colours {black brown red hotpink orange yellow green olivedrab \
	blue lightblue purple darkgrey white}

set hue(I) "#f99"
set hue(L) "#fc9"
set hue(W) "#ff9"
set hue(P) "#cf9"
set hue(N) "#9f9"
set hue(T) "#9fc"
set hue(U) "#9ff"
set hue(V) "#9cf"
set hue(F) "#99f"
set hue(X) "#c9f"
set hue(Y) "#f9f"
set hue(Z) "#f9c"

# pieces -- assign colours to the pieces
proc pieces {args} {
    global colours colour

    foreach p $args c $colours {
	if {$p == ""} break
	set colour($p) $c
    }
}

# place -- place a piece
proc place {level piece args} {
    global moves
    lappend moves $piece $args
}

# pop -- remove a piece
proc pop {level} {
    global moves
    set moves [lrange $moves 0 end-2]
}

set running 1
set ticks 0

# solution -- display n'th solution
proc solution {n} {
    global running
    set running 0
    .status configure -text "Solutions =  $n"
    progress
}

# progress -- display partial solution
proc progress {} {
    global hue moves delay w running ticks signal pipe

    .canv delete piece
    foreach {piece squares} $moves {
	set outline [outline $squares]
	eval .canv create polygon $outline \
	    -tag piece -fill $hue($piece) -outline black \
	    -width $w -joinstyle miter
    }
    update idletasks;			# Update the display
    fileevent $pipe readable ""
    if {$running} {
	after $delay [list fileevent $pipe readable command]
    } else {
	while {! $running && $ticks == 0} {
	    vwait signal
	}
	if {! $running} {incr ticks -1}
	fileevent $pipe readable command
    }

}

# finish -- finish the search
proc finish {} {
    .status configure -text "[.status cget -text] (all done)"
    update idletasks
}

### End of client commands

proc pause {} {
    global running ticks signal
    if {$running} {
	set running 0
	set ticks 0
    } else {
	incr ticks
	incr signal
    }
}

proc run {} {
    global running signal
    set running 1
    incr signal
}

set cmd "./pento -v"
if {[llength $argv] > 0} {set cmd [join $argv]}

proc command {} {
    global pipe cmd

    if [eof $pipe] {
	close $pipe
	after 5000
	set $pipe [open "|$cmd" r]
	fileevent $pipe readable command
    } else {
	gets $pipe line
	eval $line
    }
}

set pipe [open "|$cmd" r]
fileevent $pipe readable command
